#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#define _WIN32_DCOM
#include <windows.h>
#include <oleauto.h>
#include <oleacc.h>

SV* BSTR2Utf8(BSTR str) 
{
    SV *utf;
    int len;
    char *text;

    if (SysStringLen(str) > 0) {
      len = WideCharToMultiByte(CP_UTF8, 0, str, SysStringLen(str), NULL, 0, NULL, NULL);
      text = (char*)safemalloc(len);
      len = WideCharToMultiByte(CP_UTF8, 0, str, SysStringLen(str), text, len, NULL, NULL);
      utf = newSVpvn(text, len);
      SvUTF8_on(utf);
      safefree(text);
    } else {
      utf = newSVpvf("");
    }
    
  //fprintf(stderr, "BSTR2UTF8: %s\n", SvPV_nolen(utf));

    SysFreeString(str);
    return utf;
}

MODULE = Win32::OleAccxs		PACKAGE = Win32::OleAccxs

BOOT:
{
    //CoInitializeEx(NULL, COINIT_MULTITHREADED);
    CoInitialize(NULL);
}

void
AccessibleObjectFromPointXs(x, y)
  int x
  int y
INIT:
  POINT pt;
  IAccessible *pAcc;
  VARIANT var;
  HRESULT hr;
PPCODE:
  pt.x = x;
  pt.y = y;
  hr = AccessibleObjectFromPoint(pt, &pAcc, &var);
  if (SUCCEEDED(hr)) {
    XPUSHs(sv_2mortal(newSVuv((LONG)pAcc)));
    XPUSHs(sv_2mortal(newSViv((I32)var.lVal)));
  }

IAccessible *
AccessibleObjectFromWindowXs(hwnd, objid)
  HWND hwnd
  DWORD objid
INIT:
  HRESULT hr;
  IAccessible *pAcc = NULL;
  RETVAL = pAcc;
CODE:
  hr = AccessibleObjectFromWindow(hwnd, objid, IID_IAccessible, (void**)&pAcc);
  if (SUCCEEDED(hr)) {
    RETVAL = pAcc;
  }
OUTPUT:
  RETVAL 


SV *
WindowFromAccessibleObjectXs(pAcc)
  IAccessible *pAcc
INIT:
  HRESULT hr;
  HWND hwnd;
CODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }

  hr = WindowFromAccessibleObject(pAcc, &hwnd);
  if (SUCCEEDED(hr)) {
    ST(0) = sv_newmortal();
    sv_setuv( ST(0), (LONG)hwnd);
  } else 
    ST(0) = &PL_sv_undef;


LONG
AccChildCountXs(pAcc)
  IAccessible* pAcc
INIT:
  LONG cnt = 0;
  HRESULT hr;
CODE:
  if (pAcc!=NULL) {
    hr = pAcc->get_accChildCount(&cnt);
    if (FAILED(hr)) {
      cnt = 0;
    }
  }
  RETVAL = cnt;
OUTPUT:
  RETVAL

void
AccHitTestXs(pAcc, x, y)
  IAccessible* pAcc
  int x
  int y
INIT:
  VARIANT var;
  IAccessible *pChild = NULL;
  HRESULT hr;
PPCODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }
    
  hr = pAcc->accHitTest(x, y, &var);
  if (FAILED(hr) || var.vt == VT_EMPTY) {
    XSRETURN_EMPTY; 
    return;
  }
  
  if (var.vt == VT_I4) {
    XPUSHs(sv_2mortal(newSVuv((LONG)pAcc)));
    XPUSHs(sv_2mortal(newSViv((I32)var.lVal)));
  }

  if (var.vt == VT_DISPATCH && var.pdispVal!=NULL) {
    hr = var.pdispVal->QueryInterface(IID_IAccessible, (void**)&pChild);
    // Is it necessary???
    var.pdispVal->Release();

    if (SUCCEEDED(hr)) {
      // Push the child pointer into place.
      XPUSHs(sv_2mortal(newSVuv((LONG)pChild)));
      XPUSHs(sv_2mortal(newSViv((LONG)0)));
    }
  }

void 
AccLocationXs(pAcc, id)
  IAccessible* pAcc
  int id
INIT:
  HRESULT hr;
  LONG x;
  LONG y;
  LONG w;
  LONG h;
  VARIANT var;
PPCODE:
  if (pAcc == NULL) 
    croak("It isn't an IAccessible object");

  var.vt = VT_I4;
  var.lVal = id;
  hr = pAcc->accLocation(&x, &y, &w, &h, var);
  if (FAILED(hr)) {
    // FAILED, It didn't have Location
    XSRETURN_EMPTY;
    return;
  }

  XPUSHs(sv_2mortal(newSViv( (LONG) x)));
  XPUSHs(sv_2mortal(newSViv( (LONG) y)));
  XPUSHs(sv_2mortal(newSViv( (LONG) (x+w) )));
  XPUSHs(sv_2mortal(newSViv( (LONG) (y+h) )));


unsigned long
AccSelectXs(pAcc, id, flags)
  IAccessible *pAcc
  int id
  LONG flags
INIT:
  VARIANT var;
  HRESULT hr;
CODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }
    
  var.vt = VT_I4;
  var.lVal = id;
  RETVAL = pAcc->accSelect(flags, var);
OUTPUT:
  RETVAL

 
SV*
AccDescriptionXs(pAcc, id)
  IAccessible* pAcc
  int id
INIT:
  VARIANT var;
  BSTR str;
  HRESULT hr;
CODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }
    
  var.vt = VT_I4;
  var.lVal = id;
  hr = pAcc->get_accDescription(var, &str);
  if (FAILED(hr)) {
    //carp("COM Error");
    RETVAL=newSVpvf("");
  } else {
    RETVAL=BSTR2Utf8(str);
  }
OUTPUT:
  RETVAL

  
SV*
AccNameXs(pAcc, id)
  IAccessible *pAcc
  int id
INIT:
  VARIANT var;
  BSTR str;
  HRESULT hr;
CODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }
    
  var.vt = VT_I4;
  var.lVal = id;
  hr = pAcc->get_accName(var, &str);
  if (FAILED(hr)) {
    //carp("COM Error");
    RETVAL=newSVpvf("");
  } else {
    RETVAL=BSTR2Utf8(str);
  }
OUTPUT:
  RETVAL

  
SV*
AccValueXs(pAcc, id)
  IAccessible *pAcc
  int id
INIT:
  VARIANT var;
  BSTR str;
  HRESULT hr;
CODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }
    
  var.vt = VT_I4;
  var.lVal = id;
  hr = pAcc->get_accValue(var, &str);
  if (FAILED(hr)) {
    //carp("COM Error");
    RETVAL=newSVpvf("");
  } else {
    RETVAL=BSTR2Utf8(str);
  }
OUTPUT:
  RETVAL


unsigned long
AccRoleXs(pAcc, id)
  IAccessible *pAcc
  int id
INIT:
  VARIANT var; 
  VARIANT val;
  HRESULT hr;
  LONG rtn;
CODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }
    
  var.vt = VT_I4;
  var.lVal = id;
  hr = pAcc->get_accRole(var, &val);
  if (FAILED(hr) || val.vt!=VT_I4) {
    RETVAL=0;
  } else {
    RETVAL=val.lVal;
  }
OUTPUT:
  RETVAL

unsigned long
AccStateXs(pAcc, id)
  IAccessible *pAcc
  int id
INIT:
  VARIANT var; 
  VARIANT val;
  HRESULT hr;
  LONG rtn;
CODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }
    
  var.vt = VT_I4;
  var.lVal = id;
  hr = pAcc->get_accState(var, &val);
  if (FAILED(hr) || val.vt!=VT_I4) {
    RETVAL=0;
  } else {
    RETVAL=val.lVal;
  }
OUTPUT:
  RETVAL


void
AccessibleChildrenXs(pAcc)
  IAccessible *pAcc
INIT:
  HRESULT hr;
  LONG iChildStart;
  LONG cChildren;
  VARIANT *rgvarChildren;
  VARIANT var;
  LONG cObtained;
  IEnumVARIANT *ev = NULL;
  int i;
  ULONG l;
PPCODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }

  hr = pAcc->get_accChildCount(&cChildren);
  if (FAILED(hr) || cChildren==0) {
    XSRETURN_EMPTY;
    return;
  }

  rgvarChildren = (VARIANT*)safemalloc(sizeof(VARIANT) * cChildren);
  if (rgvarChildren==NULL) {
    croak("AccessibleChidrenXs: Out of Memory");
  }
    
  hr = AccessibleChildren(pAcc, 0L, cChildren, rgvarChildren, &cObtained);
  //fprintf(stderr, "AccessibleChildren:%d obtained:%d %p\n", cChildren, cObtained, rgvarChildren);
  if (FAILED(hr)) {
    safefree(rgvarChildren);
    XSRETURN_EMPTY;
    return;
  }

  // If it is less, Let's try with IEnumVARIANT
  if (cObtained < cChildren) {
    if (cObtained==1 && rgvarChildren[0].vt==VT_DISPATCH) {
      hr = rgvarChildren[0].pdispVal->QueryInterface(IID_IEnumVARIANT, (void**)&ev);
    }
    else {
      hr = pAcc->QueryInterface(IID_IEnumVARIANT, (void**)&ev);  
    }
  }

  //for (i=0;i<cObtained;++i) {
  for (i=0;i<cChildren;++i) {

    if (cObtained == cChildren)  {
      var = rgvarChildren[i];
    } else { 
      // If it support IEnumVARIANT interface
      if (ev != NULL) {
        hr = ev->Next(1, &var, &l);
        //fprintf(stderr, "IEnumVARIANT->Next:%d obtained:%d vt=%d\n", i, l, var.vt);
      }
      if (FAILED(hr))
        break;
    }

    //fprintf(stderr, "child idx: %d VT=%d var.lVal=%d var.pdispVal=%p\n", i, var.vt, var.lVal, var.pdispVal);

    if (var.vt == VT_DISPATCH && var.pdispVal!=NULL) {
      IAccessible* pChild = NULL;
      hr = var.pdispVal->QueryInterface(IID_IAccessible, (void**) &pChild);
      if (SUCCEEDED(hr))
      {
        XPUSHs(sv_2mortal(newSVuv((LONG)pChild)));
        XPUSHs(sv_2mortal(newSViv(0)));
        //fprintf(stderr, "push IDispatch child idx: %d %p\n", i, var.pdispVal);
      } else {
        croak("COM Error: QueryInterface IID_IAccessible");
      }
      // if it can't query the IAccessible, 
      // it just use the IAccessible of it parent, ??????  
      var.pdispVal->Release();
    } 

    if (var.vt == VT_I4 && var.lVal != 0) {   
      //default
      XPUSHs(sv_2mortal(newSVuv((LONG)pAcc)));
      XPUSHs(sv_2mortal(newSViv((I32)var.lVal)));
      //fprintf(stderr, "Simple child idx: %d ID=%d VT=%d\n", i, (int)var.lVal, var.vt);
    }
  }
  safefree(rgvarChildren);

  if (ev!=NULL) 
    ev->Release();

void 
AccSelectionXs(pAcc)
  IAccessible *pAcc
INIT:
  HRESULT hr;
  VARIANT varChildren;
  VARIANT var[1];
  IEnumVARIANT *ev;
  ULONG lFetched;
PPCODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }

  hr = pAcc->get_accSelection(&varChildren);
  if (FAILED(hr) || varChildren.vt==VT_EMPTY) {
    XSRETURN_EMPTY;
    return;
  }

  // VT_DISPATCH
  if (varChildren.vt==VT_DISPATCH && varChildren.pdispVal!=NULL) {
    IAccessible* pChild = NULL;
    hr = varChildren.pdispVal->QueryInterface(IID_IAccessible, (void**) &pChild);
    varChildren.pdispVal->Release();
    if(SUCCEEDED(hr))
    {
      XPUSHs(sv_2mortal(newSVuv((LONG)pChild)));
      XPUSHs(sv_2mortal(newSVuv(0)));
    } 
  }

  // VT_I4
  if (varChildren.vt==VT_I4) {
    XPUSHs(sv_2mortal(newSVuv((LONG)pAcc)));
    XPUSHs(sv_2mortal(newSVuv(varChildren.lVal)));
  }

  // VT_UNKNOWN
  if (varChildren.vt==VT_UNKNOWN && varChildren.punkVal!=NULL) {
    hr = varChildren.punkVal->QueryInterface(IID_IEnumVARIANT, (void**) &ev);
    varChildren.punkVal->Release();
    if (SUCCEEDED(hr)) {
      while (SUCCEEDED(ev->Next(1, var, &lFetched))) {
        if (var[0].vt == VT_I4) {
          XPUSHs(sv_2mortal(newSVuv((LONG)pAcc)));
          XPUSHs(sv_2mortal(newSViv((I32)var[0].lVal)));
        }
        if (var[0].vt == VT_DISPATCH && var[0].pdispVal!=NULL) {
          IAccessible* pChild = NULL;
          hr = var[0].pdispVal->QueryInterface(IID_IAccessible, (void**) &pChild);
          var[0].pdispVal->Release();
          if (SUCCEEDED(hr)) {
            XPUSHs(sv_2mortal(newSVuv((LONG)pChild)));
            XPUSHs(sv_2mortal(newSVuv(0)));
          } 
        }
      } 
      ev->Release();
    }
  }

void 
AccParentXs(pAcc)
  IAccessible *pAcc
INIT:
  HRESULT hr;
  IAccessible *pChild = NULL;
  IDispatch *disp = NULL;
PPCODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }

  hr = pAcc->get_accParent(&disp);
  if (FAILED(hr) || disp==NULL) {
    XSRETURN_EMPTY;
    return;
  }

  // VT_DISPATCH
  hr = disp->QueryInterface(IID_IAccessible, (void**) &pChild);
  if (SUCCEEDED(hr))
  {
    XPUSHs(sv_2mortal(newSVuv((LONG)pChild)));
    XPUSHs(sv_2mortal(newSVuv(0)));
  }
  disp->Release();

void 
AccNavigateXs(pAcc, id, navDir)
  IAccessible *pAcc
  int id
  long navDir
INIT:
  HRESULT hr;
  VARIANT child;
  VARIANT var;
  IAccessible *pChild = NULL;
  IDispatch *disp = NULL;
PPCODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }
 
  child.vt = VT_I4;
  child.lVal = id;
  hr = pAcc->accNavigate(navDir, child, &var);
  if (FAILED(hr) || var.vt==VT_EMPTY) {
    XSRETURN_EMPTY;
    return;
  }
  
  // VT_DISPATCH
  if (var.vt==VT_DISPATCH && var.pdispVal!=NULL) {
    hr = var.pdispVal->QueryInterface(IID_IAccessible, (void**) &pChild);
    if (SUCCEEDED(hr))
    {
      XPUSHs(sv_2mortal(newSVuv((LONG)pChild)));
      XPUSHs(sv_2mortal(newSViv(0)));
    }
    var.pdispVal->Release();
  }

  // VT_I4
  if (var.vt==VT_I4) {
    XPUSHs(sv_2mortal(newSVuv((LONG)pAcc)));
    XPUSHs(sv_2mortal(newSViv((I32)var.lVal)));
  }


unsigned long
AddRefXs(pAcc)
  IAccessible *pAcc
CODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }
  
  RETVAL = pAcc->AddRef();
OUTPUT:
  RETVAL

unsigned long
ReleaseXs(pAcc)
  IAccessible *pAcc
CODE:
  if (pAcc==NULL) {
    croak("It isn't an IAccessible object");
  }
  RETVAL = pAcc->Release();
OUTPUT:
  RETVAL


void
Initialize(dwCoInit)
  DWORD dwCoInit
PPCODE:
  CoInitialize(NULL); //, COINIT_APARTMENTTHREADED);

void
Uninitialize()
PPCODE:
  CoUninitialize();

long
SendMessage(hwnd, msg, wParam, lParam)
  HWND hwnd
  UINT msg
  WPARAM wParam
  LPARAM lParam
CODE:
  RETVAL = SendMessage(hwnd, msg, wParam, lParam);
OUTPUT:
  RETVAL
  
long
PostMessage(hwnd, msg, wParam, lParam)
  HWND hwnd
  UINT msg
  WPARAM wParam
  LPARAM lParam
CODE:
  RETVAL = PostMessage(hwnd, msg, wParam, lParam);
OUTPUT:
  RETVAL


void 
KeyboardEventXs(vk, flags)
  UINT vk;
  DWORD flags;
CODE:
  BYTE scan = MapVirtualKey(vk, 0);
  keybd_event(vk, scan, flags, 0);


void
MouseEventXs(flags, x, y, data)
  DWORD flags
  DWORD x
  DWORD y
  DWORD data
CODE:
  mouse_event(flags, x, y, data, NULL);
  Sleep(20);
  
